home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 March / CHIP Mart 1997.iso / prg / CHKIO / CHKIO.BAS < prev    next >
BASIC Source File  |  1996-06-05  |  28KB  |  1,024 lines
  1. '--------------------------------------------------------------------
  2. ' Title    : CheckIOPorts
  3. ' Version  : 1.32
  4. ' Author   : PhG
  5. ' Overview : try and locate I/O ports
  6. ' Future   : no!  ;-)
  7. ' Notes    : Special thanks to Jean-Claude Gaertner and Rick Harris
  8. '            who kindly devoted some of their precious time in order
  9. '            to have a look at this small utility!
  10. ' Usage    : CHKIO <options> [ > redirectionFile ]
  11. '
  12. ' Who When     What
  13. ' --- -------- ------------------------------------------------------
  14. ' PhG 06-06-96 v1.32 corrected a discrepancy between doc and help screen ;
  15. '              a beep as another warning ; and for safety, removed the
  16. '              possibility for the TSR to run from swapfile, i.e. 350 Kb
  17. '              of free EMS are not available then bye! ;-)
  18. ' PhG 05-27-96 v1.31
  19. ' PhG 05-26-96 v1.3 added default exclude, warning message, forced reboot
  20. ' PhG 04-23-96 v1.2 fixed a typo in help, code frozen, no future!
  21. ' PhG 04-17-96 v1.12 corrects a silly change which prevented v1.11 from
  22. '              working while v1.10 did! (zmethod -> method)
  23. '              v1.11 defaults to $200..$3FF for FREE and USED commands
  24. '              removed default values which were passed to TSR
  25. '              (firstval, etc.)
  26. ' PhG 04-15-96 v1.1 program created from CHKPORTS v1.0 Modula-2 code
  27. '--------------------------------------------------------------------
  28.  
  29. $CPU            8086 ' for old XTs!
  30.  
  31. $OPTIMIZE       SIZE
  32. $COMPILE        EXE
  33.  
  34. $DEBUG MAP      OFF
  35. $DEBUG PBDEBUG  OFF
  36.  
  37. $LIB COM        OFF
  38. $LIB CGA        OFF
  39. $LIB EGA        OFF
  40. $LIB VGA        OFF
  41. $LIB HERC       OFF
  42. $LIB LPT        OFF
  43. $LIB IPRINT     OFF
  44. $LIB FULLFLOAT  OFF
  45.  
  46. $ERROR BOUNDS   OFF
  47. $ERROR NUMERIC  OFF
  48. $ERROR OVERFLOW OFF
  49. $ERROR STACK    OFF
  50.  
  51. $FLOAT          PROCEDURE
  52.  
  53. $COM            0
  54. $STRING         1 ' 1K strings is enough here
  55. $STACK          2048
  56. $SOUND          1
  57.  
  58. $DIM            ARRAY
  59.  
  60. $DYNAMIC
  61.  
  62. $OPTION         CNTLBREAK OFF
  63.  
  64. '--------------------------------------------------------------------
  65.  
  66. DEFINT A-Z
  67. OPTION ARRAY BASE 0
  68. OPTION BINARY BASE 0
  69.  
  70. %False = 0
  71. %True  = NOT %False
  72.  
  73. %Dummy = %true
  74.  
  75. '--------------------------------------------------------------------
  76. ' externals
  77. ' you'll have to supply your own functions if you want to recompile!
  78.  
  79. $LINK "SKYTOOLS.PBU"
  80. $INCLUDE "C:\ASTRO\SKYTOOLS.DEF"
  81.  
  82. $INCLUDE "C:\PB\SRC\REGNAMES.BAS"
  83.  
  84. DECLARE SUB GetStrLoc() ' PB 3.1 runtime routine for locating strings
  85.  
  86. '--------------------------------------------------------------------
  87. ' error handling
  88.  
  89. %eNone      = 100
  90. %eUsage     = 101
  91. %eDosTooOld = 102
  92. %eBadExeName= 103
  93. %eTooMany   = 104
  94. %eTooManyParms=105
  95. %ejoker     = 106
  96. %ebadfilename=107
  97. %ebakpb     = 108
  98. %ebadnumber = 109
  99. %ebadrangeio  = 110
  100. %emissingparms=111
  101. %ebadcount  = 112
  102. %ebadext    = 113
  103. %ealreadyloaded=114
  104. %eneeded=115
  105. %enotloaded = 116
  106. %enotyettsr = 117
  107. %ecantunloadfull = 118
  108. %ebadrangetick = 119
  109. %eAborted=120
  110. %eEMSneeded=121
  111.  
  112. '--------------------------------------------------------------------
  113. ' constants
  114.  
  115. %MinDosVersion = 310 ' 3.10 or later
  116.  
  117. %cmdNone    = &HFF
  118. %cmdInstallTSR  = &H00
  119. %cmdReport  = &h01
  120. %cmdReset   = &h02
  121. %cmdStatus  = &H03
  122. %cmdUnload  = &H04
  123. %cmdScanPort= &H05
  124. %cmdFree    = &H06
  125. %cmdUsed    = &H07
  126.  
  127. %rcWasHere  = &H08
  128.  
  129. %idAX       = &HDADB
  130. %idDX       = &HFBFA
  131. %idFooBar   = &HFFFF
  132.  
  133. %Multiplex    = &H2F
  134. %PopMultiplex = 16
  135. %PopTimer     = 4
  136. %Dos          = &H21
  137. %hi           = &H100
  138. %EMSPage      = &H4000
  139. %EMS          = &H67
  140. %OneK         = &H400
  141.  
  142. %MemGrab    = &HA0000
  143. %MemUse     = &H2000
  144. %NeededEMS  = 350000 ' 160 Kb needed but for sure...
  145. %NeededDisk = 350000 ' &H7FFFFFFF force EMS only - disk swapping+timer sucks
  146.  
  147. %MinPopInterval     = 1  ' unit = 1/18.2s
  148. %MaxPopInterval     = 1820 ' 100 seconds ?
  149.  
  150. %defaultcount = 16
  151.  
  152. %emptyB    = &HFF
  153. %EmptyW    = &HFFFF ' unused here (was when checking for a word value p,p+1)
  154. %FirstPort = &H0000
  155. %LastPort  = &H03FF
  156. %DefaultFirstPort = &h0200 ' better safe than sorry
  157.  
  158. %firstHD = &h0320 ' hard disk controller
  159. %lastHD  = &h032F
  160. %firstFD = &h03F0 ' floppy disk controller
  161. %lastFD  = &h03F7
  162.  
  163. '--------------------------------------------------------------------
  164.  
  165. %portnotyettested = 0
  166. %portusedonce = 1
  167. %portfreetillnow = 2
  168.  
  169. ' global array
  170. DIM STATIC IOport (%FirstPort:%LastPort) ' compile time
  171. SHARED IOport()
  172.  
  173. '--------------------------------------------------------------------
  174. ' global variables
  175.  
  176. SHARED Programname$,Exename$,Version$,Copyright$,Swapfilename$
  177. SHARED Defaultext$,Defaultbak$,Banner$
  178. SHARED firstval,lastval,Reportfile$ ' in case TSR would be funny
  179. SHARED Begtime$
  180. SHARED method
  181.  
  182. '--------------------------------------------------------------------
  183.  
  184. Programname$ = "Q&D CheckIOPorts"
  185. Exename$     = "CHKIO"
  186. Version$     = "v1.32"
  187. Copyright$   = "(c) PhG 1996"
  188. Swapfilename$= "~CHKIO.TMP" ' no longer possible for safety
  189. Defaultext$  = "RPT"
  190. Defaultbak$  = "BAK"
  191. Banner$=Programname$+" "+Version$+" "+Copyright$
  192.  
  193. '
  194. ON ERROR GOTO Abort
  195.  
  196. GOTO Start: ' jump to main() ;-)
  197.  
  198. '--------------------------------------------------------------------
  199.  
  200. Abort:
  201. IF ERR = %eUsage THEN
  202.     PRINT Banner$
  203.     PRINT
  204.     PRINT "Syntax: '";Exename$;" <options> [>file]', where options (without / or -) are:"
  205.     PRINT
  206.     PRINT "- <port> [count] checks 'count' I/O ports starting from 'port'"
  207.     PRINT "  'port' belongs to the [$0000..$03FF] range, 'count' default value is 16"
  208.     PRINT "  Values are given in decimal, unless they begin with a '$' for hexadecimal"
  209.     PRINT "- FREE shows the most probably unused I/O ports in the [$0200..$03FF] range"
  210.     PRINT "- USED shows the most probably used I/O ports in the [$0200..$03FF] range"
  211.     PRINT "- SAMPLE <ticks> <port> [count] install program as a TSR"
  212.     PRINT "  'ticks' is the sampling frequency (one tick is 1/18.2s)"
  213.     PRINT "- RESET reinitializes results got from TSR"
  214.     PRINT "- REPORT dumps current results to ";Exename$;".";Defaultext$;" file"
  215.     PRINT "  Previous file of same name is kept as ";exename$;".";Defaultbak$
  216.     PRINT "- STATUS shows current TSR status"
  217.     PRINT "- UNLOAD tries and unloads program from memory"
  218.     PRINT
  219.     PRINT "For SAFETY, FREE and USED commands do NOT test hard disk and floppy I/O ports."
  220.     PRINT "Program can *try* 4 methods to check whether I/O ports are used or not."
  221.     PRINT "To specify survey method, enter M0, M1, M2 or M3 as the *first* parameter."
  222.     PRINT "Default is M0. Beware: once program is TSR, you CANNOT change survey method!"
  223.     PRINT
  224.     PRINT "Special thanks to Jean-Claude Gaertner and Rick Harris who kindly devoted"
  225.     PRINT "some of their precious time in order to have a look at this small utility!";
  226.     END %eUsage-%eNone
  227. END IF
  228. SELECT CASE ERR
  229. CASE %eUsage
  230.     E$="How can such things be?"
  231. CASE %eDosTooOld
  232.     E$="DOS version should be 3.1 or later"
  233. CASE %eBadExeName
  234.     E$="Executable name was changed"
  235. CASE %eToomany
  236.     E$="At least one option repeated needlessly"
  237. CASE %etoomanyparms
  238.     E$="Too many parameters in command line"
  239. CASE %ejoker
  240.     E$="No joker allowed in filename"
  241. CASE %ebadfilename
  242.     E$="Illegal filename"
  243. CASE %ebakpb
  244.     E$="Problem while trying to create backup copy of report"
  245. CASE %ebadnumber
  246.     E$="Illegal number or command" ' mispelled cmd goes there!
  247. CASE %ebadrangeio
  248.     E$="I/O port address should be in the [$0000..$03FF] range"
  249. CASE %emissingparms
  250.     E$="Missing parameter(s)"
  251. CASE %ebadcount
  252.     E$="Bad I/O port interval"
  253. CASE %ebadext
  254.     E$="Report cannot have backup extension"
  255. CASE %ealreadyloaded
  256.     E$="Program already installed"
  257. CASE %eneeded
  258.     E$="Not enough space for swap area (EMS or disk)"
  259. CASE %enotloaded
  260.     E$="Nonsense, for program is not in memory"
  261. CASE %enotyettsr
  262.     E$="Nonsense, for program is not in memory"
  263. CASE %eCantUnloadFull
  264.     E$= "6 KB lost in memory, for uninstall could not be fully completed"
  265.     E$= E$+CHR$(13)+CHR$(10)
  266. CASE %ebadrangetick
  267.     E$="Ticks should be in the [1..1820] range"
  268. CASE %eAborted
  269.     E$="Execution cancelled"
  270. CASE %eEMSneeded
  271.     E$="Not enough EMS free for swap area (about 350 Kb needed)"
  272. CASE ELSE
  273.     E$=HEX$(ERADR) ' ERADR is a longint (7fFFffFF)
  274.     h$="00000000"
  275.     padcount=len(h$)-len(e$)
  276.     hexa$=MID$(h$,1,padcount)
  277.     e$=hexa$+E$
  278.     E$= "Error #"+MID$(STR$(ERR),2)+" at address $"+E$
  279. END SELECT
  280. E$=Programname$+": "+E$+"!"
  281. PRINT E$;
  282. END ERR-%eNone
  283.  
  284. '--------------------------------------------------------------------
  285.  
  286. SUB StdOut ( BYVAL Text AS STRING )
  287. ! push DS                    ; save DS FOR PowerBASIC
  288. ! push WORD Ptr Text         ; push STRING handle ON stack
  289. ! CALL GetStrLoc
  290. ! jcxz ExitStdOut
  291. ! mov  DS, DX
  292. ! mov  DX, AX
  293. ! mov  AH, &H40              ; DOS WRITE TO file
  294. ! mov  BX, 1                 ; file handle 1 is CONS
  295. ! INT  &H21
  296. ExitStdOut:
  297. ! pop  DS
  298. END SUB
  299.  
  300. SUB StdOutLn( BYVAL Text AS STRING )
  301. StdOut Text$ + CHR$(13, 10)
  302. END SUB
  303.  
  304. '--------------------------------------------------------------------
  305.  
  306. '
  307. FUNCTION EMSHere
  308. REG %AX, &H35*%hi+&H67 ' get int 67h address
  309. CALL INTERRUPT %Dos
  310. Driversegment??=REG(%ES)
  311. DEF SEG = Driversegment??
  312. Drivername$=PEEK$(&H00+&H0A,8) ' name at offset $0A
  313. DEF SEG
  314. IF Drivername$="EMMXXXX0" THEN
  315.     EMSHere = %True
  316. ELSE
  317.     EMSHere = %False
  318. END IF
  319. END FUNCTION
  320.  
  321. '
  322. FUNCTION EMSOK
  323. REG %AX , &H40*%hi ' get status
  324. CALL INTERRUPT %EMS
  325. Rc?? = REG(%AX)
  326. IF (Rc?? \ %hi) = &H00 THEN
  327.     EMSOK = %True
  328. ELSE
  329.     EMSOK = %False
  330. END IF
  331. END FUNCTION
  332.  
  333. '
  334. FUNCTION Getfreeems???
  335. IF EMSHere = %True THEN
  336.     IF EMSOK = %True THEN
  337.       REG %AX , &H42*%hi ' get # of pages
  338.       CALL INTERRUPT %EMS
  339.       Rc?? = REG(%AX)
  340.       IF (rc \ %hi) = &H00 THEN
  341.         Getfreeems??? = REG(%BX) * %EMSPage
  342.       ELSE
  343.         Getfreeems??? = 0
  344.       END IF
  345.     END IF
  346. END IF
  347. END FUNCTION
  348.  
  349. '
  350. FUNCTION Getmyfreespace???(BYVAL drive) ' 1=A:, 3=C:, 4=D:
  351. REG(%DX),drive
  352. REG(%AX),&H36*%hi
  353. CALL INTERRUPT %Dos
  354. SectorsPerCluster = REG(%AX)
  355. IF SectorsPerCluster = &HFFFF THEN ' drive does not exist
  356.     Getmyfreespace???=0
  357. ELSE
  358.     FreeClusters=REG(%BX)
  359.     BytesPerSector = REG(%CX)
  360.     Free???=SectorsPerCluster*FreeClusters*BytesPerSector
  361.     Getmyfreespace???=Free???
  362. END IF
  363. END FUNCTION
  364.  
  365. '
  366. SUB BuildSwapPath (BYVAL Swp$,P$,Free???)
  367. T$=Upper$(ENVIRON$("TMP"))
  368. IF T$="" THEN
  369.     T$=Upper$(ENVIRON$("TEMP"))
  370. END IF
  371. IF T$="" THEN
  372.     n=3
  373.     P$="C:\"
  374. ELSE
  375.     IF RIGHT$(T$,1) <> "\" THEN
  376.       T$=T$+"\"
  377.     END IF
  378.     IF MID$(T$,2,2) = ":\" THEN
  379.       n = ASC(LEFT$(T$,1))-ASC("A")+1
  380.       P$=T$
  381.     ELSE
  382.       n=3
  383.       P$="C:\"
  384.     END IF
  385. END IF
  386. P$=P$+Swp$
  387. Free???=Getmyfreespace???(n)
  388. END SUB
  389.  
  390. '--------------------------------------------------------------------
  391.  
  392. SUB ShowBanner(BYVAL ticks, BYVAL firstval, BYVAL lastval, BYVAL flagEMS, BYVAL Swappath$)
  393. PRINT Banner$
  394. PRINT
  395. PRINT "TSR Swap area      : ";
  396. IF flagEMS = %true THEN
  397.     PRINT "EMS memory"
  398. ELSE
  399.     PRINT Swappath$;" file"
  400.     PRINT "                    (very BAD idea... unless you use a RAM disk)"
  401. END IF
  402. IF firstval=lastval THEN
  403. PRINT "Sampled I/O address: $"; Padhex$(firstval,4)
  404. ELSE
  405. PRINT "Sampled I/O range  : [$"; Padhex$(firstval,4);
  406.     PRINT "..$";Padhex$(lastval,4);"]"
  407. END IF
  408. S$=MID$(STR$(ticks),2)
  409. PRINT "Sampling fréquency : every ";S$;" tick";
  410. IF ticks> 1 THEN PRINT "s";
  411. PRINT " (one tick is 1/18.2s)"
  412. END SUB
  413.  
  414. '--------------------------------------------------------------------
  415.  
  416. FUNCTION getnumber(BYVAL V$,Value&)
  417. SELECT CASE LEFT$(V$,1)
  418. CASE "$"
  419.     V$=MID$(V$,2)
  420.     IF VERIFY (V$,"0123456789ABCDEF") > 0 THEN
  421.        getnumber=%false
  422.        EXIT FUNCTION
  423.     END IF
  424.     ' $FFFFffff is safe maximum so check overflow
  425.     IF LEN(V$) > 8 THEN
  426.        getnumber=%false
  427.        EXIT FUNCTION
  428.     END IF
  429.     H$="&H0"+V$
  430.     A???=VAL(H$)
  431.     IF A??? < 2147483648 THEN
  432.        N&=A???
  433.     ELSE
  434.        N&=VAL("&H"+V$)
  435.     END IF
  436. CASE ELSE
  437.     IF VERIFY (V$,"0123456789") > 0 THEN
  438.        getnumber=%false
  439.        EXIT FUNCTION
  440.     END IF
  441.     N&=VAL(V$)
  442. END SELECT
  443. Value&=N&
  444. getnumber=%true
  445. END FUNCTION
  446.  
  447. FUNCTION chkrange(V&,First&,Last&)
  448. IF V& < First& OR V& > Last& THEN
  449.     chkrange=%false
  450. ELSE
  451.     chkrange=%true
  452. END IF
  453. END FUNCTION
  454.  
  455. FUNCTION parmtoval (BYVAL Cli$,BYVAL n)
  456. V$=Argv$(Cli$,n)
  457. IF getnumber(V$,V&)=%false THEN ERROR %ebadnumber
  458. IF chkrange(V&,%firstport,%lastport)=%false THEN ERROR %ebadrangeio
  459. parmtoval=V&
  460. END FUNCTION
  461.  
  462. '--------------------------------------------------------------------
  463.  
  464. SUB ParseCLI (cmd,zticks,zfirstval,zlastval,Reportfile$,zmethod)
  465.  
  466. Cli$=Upper$(COMMAND$)
  467. argcount=argc(Cli$)
  468.  
  469. IF argcount=0 THEN ERROR %eusage
  470.  
  471. foundSOSarg=FindArg(Cli$,"?|H|HELP|SOS",%False)
  472. foundSOSopt=FindOpt(Cli$,"?|H|HELP|SOS",%False)
  473. SELECT CASE (foundSOSarg+foundSOSopt)
  474. CASE 0
  475.       ' no help call
  476. CASE 1
  477.       ERROR %eUsage
  478. CASE ELSE
  479.       ERROR %eTooMany
  480. END SELECT
  481.  
  482. ' init defaults here even when not needed
  483. cmd     = %cmdNone
  484. zticks   = %minPopInterval
  485. zfirstval= %defaultfirstport
  486. zlastval = %lastport
  487. Reportfile$=Exename$+"."+Defaultext$
  488.  
  489. zmethod = 0 ' default method
  490.  
  491. patch=%true
  492. SELECT CASE Argv$(Cli$,1)
  493. CASE "M0"
  494.     zmethod=0
  495. CASE "M1"
  496.     zmethod=1
  497. CASE "M2"
  498.     zmethod=2
  499. CASE "M3"
  500.     zmethod=3
  501. CASE ELSE
  502.     patch=%false
  503. END SELECT
  504. IF patch=%true THEN
  505.     Newcli$=""
  506.     FOR i=2 TO argcount
  507.        Newcli$=Newcli$+" "+Argv$(Cli$,i)
  508.     NEXT
  509.     Cli$=Newcli$
  510.     DECR argcount
  511. END IF
  512.  
  513. SELECT CASE Argv$(Cli$,1)
  514. CASE "FREE"
  515.     IF argcount > 1 THEN ERROR %etoomanyparms
  516.     cmd=%cmdFree
  517. CASE "USED"
  518.     IF argcount > 1 THEN ERROR %etoomanyparms
  519.     cmd=%cmdUsed
  520. CASE "SAMPLE","TSR","S"
  521.     IF argcount > 4 THEN ERROR %etoomanyparms
  522.     IF argcount < 3 THEN ERROR %emissingparms
  523.     V$=Argv$(Cli$,2)
  524.     IF getnumber(V$,V&)=%false THEN ERROR %ebadnumber
  525.     IF chkrange(V&,%minpopinterval,%maxpopinterval)=%false THEN ERROR %ebadrangetick
  526.     zticks=V&
  527.     zfirstval=parmtoval(Cli$,3)
  528.     SELECT CASE argcount
  529.     CASE 3
  530.        zcount=%defaultcount
  531.     CASE ELSE
  532.        zcount=parmtoval(Cli$,4)
  533.     END SELECT
  534.     zlastval=zfirstval+zcount-1
  535.     IF zlastval < zfirstval THEN ERROR %ebadcount
  536.     cmd=%cmdInstallTSR
  537. CASE "REPORT","RPT","R"
  538.     SELECT CASE argcount
  539.     CASE 1
  540.        ' already set
  541. $IF 0
  542.     CASE 2 ' useless for we cannot change TSR variables this way!
  543.        F$=Argv$(Cli$,2)
  544.        IF INSTR(F$,ANY "*?") > 0 THEN ERROR %eJoker
  545.        IF INSTR(F$,".")=0 THEN F$=F$+"."+Defaultext$
  546.        IF TALLY(F$,".") > 1 THEN ERROR %ebadfilename
  547.        CALL SplitPath(F$,Fcurrunit$,Fcurrpath$,Fcurrfile$)
  548.         CALL SplitName(Fcurrfile$,F8$,F3$)
  549.        IF F3$=Defaultbak$ THEN ERROR %ebadext
  550.        Reportfile$=F$
  551. $ENDIF
  552.     CASE ELSE
  553.        ERROR %etoomanyparms
  554.     END SELECT
  555.     IF exist(Reportfile$)=%true THEN
  556.        rc=makebak(Reportfile$,Defaultbak$)
  557.        IF rc=%false THEN ERROR %ebakpb
  558.     END IF
  559.     cmd=%cmdReport
  560. CASE "RESET","RST","Z"
  561.     IF argcount > 1 THEN ERROR %etoomanyparms
  562.     cmd=%cmdReset
  563. CASE "STATUS","I"
  564.     IF argcount > 1 THEN ERROR %etoomanyparms
  565.     cmd=%cmdStatus
  566. CASE "UNLOAD","U"
  567.     IF argcount > 1 THEN ERROR %etoomanyparms
  568.     cmd=%cmdUnload
  569. CASE ELSE
  570.     IF argcount > 2 THEN ERROR %etoomanyparms
  571.     zfirstval=parmtoval(Cli$,1)
  572.     SELECT CASE argcount
  573.     CASE 1
  574.        zcount=%defaultcount
  575.     CASE ELSE
  576.        zcount=parmtoval(Cli$,2)
  577.     END SELECT
  578.     zlastval=zfirstval+zcount-1
  579.     IF zlastval < zfirstval THEN ERROR %ebadcount
  580.     cmd=%cmdScanPort
  581. END SELECT
  582. END SUB
  583.  
  584. '--------------------------------------------------------------------
  585.  
  586. ' SUB resetarray (BYVAL firstval,BYVAL lastval)
  587. ' FOR i = firstval TO lastval
  588. '    ioport(i)=%portnotyettested
  589. ' NEXT
  590. ' END SUB
  591.  
  592. SUB reportarray(BYVAL firstval,BYVAL lastval,BYVAL F$)
  593. hnd=FREEFILE
  594. OPEN "o",#hnd,F$
  595. FOR i = firstval TO lastval
  596.     S$="I/O port $"+Padhex$(i,4)
  597.     SELECT CASE ioport(i)
  598.     CASE %portnotyettested
  599.         T$=" has not been tested YET: how did you get here? ;-)"
  600.     CASE %portfreetillnow
  601.         T$=" is probably free"
  602.     CASE %portusedonce
  603.         T$=" is probably NOT free"
  604.     END SELECT
  605.     S$=S$+T$
  606.     PRINT #hnd,S$
  607.     PRINT S$
  608. NEXT
  609. CLOSE #hnd
  610. END SUB
  611.  
  612. '--------------------------------------------------------------------
  613.  
  614. FUNCTION Padhex$ (BYVAL v,BYVAL padcount)
  615. Padstr$ = "0000000000000000" ' 16 digits
  616. padcount = padcount MOD 16 ' better safe than sorry!
  617. S$=HEX$(v)
  618. Padhex$=MID$(Padstr$,1,padcount-LEN(S$))+S$
  619. END FUNCTION
  620.  
  621. SUB ShowIOport (BYVAL io,BYVAL vlo,BYVAL vhi)
  622. S$="I/O port $"+Padhex$(io,4)
  623. IF isfree(vlo,vhi)=%true THEN
  624.     S$=S$+" is probably free ($"
  625. ELSE
  626.     S$=S$+" is probably NOT free ($"
  627. END IF
  628. S$=S$+Padhex$(vhi,2)
  629. S$=S$+Padhex$(vlo,2)
  630. S$=S$+")"
  631. CALL StdOutLn (S$) ' allow redirecting output to file
  632. END SUB
  633.  
  634. SUB SkipIOport (BYVAL io)
  635. S$="I/O port $"+Padhex$(io,4)
  636. S$=S$+" was *not* tested, for safety"
  637. CALL StdOutLn (S$) ' allow redirecting output to file
  638. END SUB
  639.  
  640.  
  641. '--------------------------------------------------------------------
  642.  
  643. ' INP method
  644. ' 0 = read port, port+1 and check if %empty
  645. ' 1 = read port, port+1 and check if values differ from one another
  646. ' 2 = read port, port and check if %empty
  647. ' 3 = read port, port and check if values differ from one another
  648.  
  649. ' method 0 seems best, or 2 perhaps. 3 is a no-no.
  650.  
  651. SUB readport (BYVAL i,vlo,vhi)
  652. SELECT CASE method
  653. CASE 0,1
  654.     vlo=INP(i)
  655.     vhi=INP(i+1)
  656. CASE 2,3
  657.     vlo=INP(i)
  658.     vhi=INP(i)
  659. END SELECT
  660. END SUB
  661.  
  662. FUNCTION isfree (BYVAL vlo, BYVAL vhi)
  663. rc=%false
  664. SELECT CASE method
  665. CASE 0,2
  666.     IF ( (vlo=%emptyb) AND (vhi=%emptyb) ) THEN rc=%true
  667. CASE 1,3
  668.     IF vlo = vhi THEN rc=%true
  669. END SELECT
  670. isfree=rc
  671. END FUNCTION
  672.  
  673. '--------------------------------------------------------------------
  674.  
  675. $if %dummy
  676.  
  677. SUB MyBeep
  678. SOUND 444,2
  679. SOUND 222,2
  680. END SUB
  681.  
  682. FUNCTION GoOnAfterWarning
  683. rc=%False
  684. PRINT
  685. RESTORE Warning
  686. DO
  687.     READ s$
  688.     IF s$="*" THEN EXIT LOOP
  689.     PRINT s$
  690. LOOP
  691. ok$="yES"
  692. prompt$="Enter ["+ok$+"] (y, E, S) if you *really* want to go on:"
  693. PRINT
  694. PRINT prompt$;
  695. CALL MyBeep
  696. INPUT " ",s$
  697. PRINT
  698. s$=RTRIM$(LTRIM$(s$))
  699. IF s$=ok$ THEN rc=%True
  700. GoOnAfterWarning=rc
  701. Warning:
  702. DATA "****************************************************************"
  703. DATA "* Warning!!!  Think twice before you run this program!         *"
  704. DATA "* In your own interest, be sure you have fully read CHKIO's    *"
  705. DATA "* documentation *before* you proceed, for running this program *"
  706. DATA "* without knowing what it is about is definitely *not* wise!   *"
  707. DATA "* This warning is all the more important with TSR option!      *"
  708. DATA "****************************************************************"
  709. DATA "*"
  710. END FUNCTION
  711.  
  712. FUNCTION RebootAfterWarning
  713. rc=%True
  714. PRINT
  715. RESTORE PleaseReboot
  716. DO
  717.     READ s$
  718.     IF s$="*" THEN EXIT LOOP
  719.     PRINT s$
  720. LOOP
  721. ok$="yES"
  722. prompt$="Enter ["+ok$+"] (y, E, S) if you *really* want to exit to DOS:"
  723. PRINT
  724. PRINT prompt$;
  725. CALL MyBeep
  726. INPUT " ",s$
  727. PRINT
  728. s$=RTRIM$(LTRIM$(s$))
  729. IF s$=ok$ THEN rc=%False
  730. RebootAfterWarning=rc
  731. PleaseReboot:
  732. DATA "****************************************************************"
  733. DATA "* Warning!!!  Think twice before you exit this program!        *"
  734. DATA "* Whatever I/O ports have been tested, you definitely should   *"
  735. DATA "* turn you PC off then on again!  At any case, you'd better    *"
  736. DATA "* not exit to DOS now but reboot your system instead!          *"
  737. DATA "****************************************************************"
  738. DATA "*"
  739. END FUNCTION
  740.  
  741. $else
  742.  
  743. FUNCTION GoOnAfterWarning
  744. rc=%true
  745. GoOnAfterWarning=rc
  746. END FUNCTION
  747.  
  748. FUNCTION RebootAfterWarning
  749. rc=%false
  750. RebootAfterWarning=rc
  751. END FUNCTION
  752.  
  753. $endif
  754.  
  755.  
  756. SUB ChkReboot
  757. IF RebootAfterWarning = %True THEN
  758.     PRINT "********************************************************"
  759.     PRINT "* System is now willingly lost in an infinite loop!    *"
  760.     PRINT "* Either reboot with Ctrl-Alt-Del or the Reset button! *"
  761.     PRINT "* Even better, turn your PC off then on again!         *"
  762.     PRINT "********************************************************"
  763.     DO
  764.        LOOP
  765. END IF
  766. END SUB
  767.  
  768. SUB ChkHdRisk(BYVAL p1, BYVAL p2)
  769. match=0
  770. FOR i = p1 to p2
  771.        SELECT CASE i
  772.     CASE %firstHD TO %lastHD, %firstFD TO %lastFD
  773.         incr match
  774.     END SELECT
  775. NEXT
  776. if match > 0 then
  777.     PRINT "***********************************************************"
  778.     PRINT "* Warning!!! Specified range include dangerous addresses! *"
  779.     PRINT "* (i.e. hard disk and/or floppy disk controllers)         *"
  780.     PRINT "***********************************************************"
  781. end if
  782. END SUB
  783.  
  784. '--------------------------------------------------------------------
  785. ' main()
  786. Start:
  787.  
  788. IF DosVersion < %minDosVersion THEN ERROR %eDosTooOld
  789.  
  790. Exepath$= Getarg0$
  791. Exepath$= Upper$(Exepath$)
  792. CALL SplitPath(Exepath$,Currunit$,Currpath$,Currfile$)
  793. CALL SplitName(Currfile$,Filename$,Ext$)
  794. IF Filename$ <> Exename$ THEN ERROR %eBadExeName
  795.  
  796. CALL ParseCLI (cmd,zticks,zfirstval,zlastval,Reportfile$,zmethod)
  797.  
  798. ' was a CALL resetarray (firstval, lastval)
  799. FOR i = zfirstval TO zlastval
  800.     ioport(i)=%portnotyettested
  801. NEXT
  802.  
  803. SELECT CASE cmd
  804. CASE %cmdInstallTSR
  805.     REG %AX,%idAX
  806.     REG %DX,%idDX
  807.     REG %BX,%cmdInstallTSR
  808.     CALL INTERRUPT %Multiplex
  809.     IF NOT (REG(%AX) = %idAX AND REG(%DX) = %idDX AND REG(%BX) = %cmdInstallTSR) THEN
  810.        ERROR %eAlreadyLoaded
  811.     END IF
  812.  
  813.     CALL BuildSwapPath(Swapfilename$,Swappath$,Freedisk???)
  814.     Freeems??? = Getfreeems??? ' 0 if none or if error
  815.     FlagEMS = %True
  816.     IF Freeems??? < %NeededEMS THEN
  817.         FlagEMS = %False
  818.         ' IF Freedisk??? < %NeededDisk THEN ERROR %eNeeded
  819.         ' no longer allow swapfile, we abort here
  820.         ERROR %eEMSNeeded
  821.     END IF
  822.  
  823.     CALL ChkHdRisk (zfirstval,zlastval)
  824.  
  825.     IF GoOnAfterWarning=%False THEN ERROR %eAborted
  826.  
  827.     ticks=zticks
  828.     firstval=zfirstval
  829.     lastval=zlastval
  830.     method=zmethod
  831.  
  832.     CALL ShowBanner(ticks,firstval,lastval,flagEMS,Swappath$)
  833.  
  834.     X??? = SETMEM(-%MemGrab)
  835.     X??? = SETMEM(%MemUse)
  836.  
  837.     POPUP MULTIPLEX %idAX, %idDX
  838.     POPUP TIMER ticks
  839.     POPUP SLEEP USING EMS,Swappath$ ' need about 200 Kb
  840.  
  841.     Begtime$=TIME$
  842.     ' in fact one should not try using EMS if FlagEMS is false but... ;-)
  843.  
  844.     DO
  845.         popmethod = POPUP(4)
  846.         SELECT CASE popmethod
  847.         CASE %PopMultiplex
  848.             cmd = REG(%BX)
  849.             SELECT CASE cmd
  850.             CASE %cmdReport
  851.                 REG %AX, %idAX
  852.                 REG %DX, %idDX
  853.                 REG %BX, %rcWasHere
  854.                 CALL reportarray (firstval,lastval,Reportfile$)
  855.  
  856.             CASE %cmdReset
  857.                 REG %AX, %idAX
  858.                 REG %DX, %idDX
  859.                 REG %BX, %rcWasHere
  860.                 ' was a CALL resetarray (firstval,lastval)
  861.                 FOR i = firstval TO lastval
  862.                     ioport(i)=%portnotyettested
  863.                     ?".";
  864.                 NEXT
  865.  
  866.                 PRINT "Reset done!"
  867.  
  868.             CASE %cmdStatus
  869.                 REG %AX, %idAX
  870.                 REG %DX, %idDX
  871.                 REG %BX, %rcWasHere
  872.                 CALL ShowBanner(ticks,firstval,lastval,flagEMS,Swappath$)
  873.                 PRINT "Install time       : ";BegTime$ ' same length
  874.                 PRINT "Current time       : ";TIME$
  875.  
  876.             CASE %cmdInstallTSR
  877.                 REG %AX, %idAX
  878.                 REG %DX, %idDX
  879.                 REG %BX, %rcWasHere
  880.  
  881.             CASE %cmdUnload
  882.                 REG %AX, %idAX
  883.                 REG %DX, %idDX
  884.                 REG %BX, %rcWasHere
  885.                 ' message MUST be HERE !
  886.                 PRINT "Uninstalling ";Programname$;"..."
  887.                 ' if END here, TSR is desactivated but...
  888.                 ' 6 KB remain lost and vectors remain hooked so...
  889.                 Retry = 0
  890.                 POPUP TIMER 9 ' every 0.5 s try at most 10 times (2 now)
  891.                 DO WHILE Retry < 2
  892.                     POPUP SLEEP
  893.                     IF POPUP(1) <> %False THEN
  894.                         ' message no longer here for must be before retries
  895.                         POPUP TIMER OFF
  896.  
  897.                         CALL ChkReboot
  898.  
  899.                         END %eNone-%eNone
  900.                     END IF
  901.                     INCR Retry
  902.                 LOOP
  903.                 ' cannot end here with POPUP STUFF a CR nor ERROR % !!! so...
  904.                 POPUP TIMER OFF
  905.                 BEEP
  906.  
  907.                 CALL ChkReboot
  908.  
  909.                 END %eCantUnloadFull-%eNone
  910.             END SELECT
  911.         CASE %PopTimer
  912.             ' perform sampling here
  913.             FOR i = firstval TO lastval
  914.                 CALL readport (i,vlo,vhi)
  915.                 was=IOport(i)
  916.                 SELECT CASE isfree(vlo,vhi)
  917.                 CASE %true
  918.                     SELECT CASE was
  919.                     CASE %portnotyettested
  920.                         IOport(i)=%portfreetillnow
  921.                     END SELECT
  922.                 CASE %false
  923.                     SELECT CASE was
  924.                     CASE %portnotyettested,%portfreetillnow
  925.                         IOport(i)=%portusedonce
  926.                     END SELECT
  927.                 END SELECT
  928.             NEXT
  929.         END SELECT
  930.         POPUP SLEEP
  931.     LOOP
  932. CASE %cmdReport
  933.     REG %AX,%idAX
  934.     REG %DX,%idDX
  935.     REG %BX,%cmdReport
  936.     CALL INTERRUPT %Multiplex
  937.     IF (REG(%AX) = %idAX AND REG(%DX) = %idDX AND REG(%BX) = %cmdReport) THEN
  938.         ERROR %eNotYetTSR
  939.     END IF
  940.  
  941.     ' report must be in TSR code
  942. CASE %cmdReset
  943.     REG %AX,%idAX
  944.     REG %DX,%idDX
  945.     REG %BX,%cmdReset
  946.     CALL INTERRUPT %Multiplex
  947.     IF (REG(%AX) = %idAX AND REG(%DX) = %idDX AND REG(%BX) = %cmdReset) THEN
  948.         ERROR %eNotYetTSR
  949.     END IF
  950.  
  951.     ' reset must be in TSR code
  952. CASE %cmdStatus
  953.     REG %AX,%idAX
  954.     REG %DX,%idDX
  955.     REG %BX,%cmdStatus
  956.     CALL INTERRUPT %Multiplex
  957.     IF (REG(%AX) = %idAX AND REG(%DX) = %idDX AND REG(%BX) = %cmdStatus) THEN
  958.         ERROR %eNotYetTSR
  959.     END IF
  960.  
  961.     ' display must be in TSR code
  962. CASE %cmdUnload
  963.     REG %AX,%idAX
  964.     REG %DX,%idDX
  965.     REG %BX,%cmdUnload
  966.     CALL INTERRUPT %Multiplex
  967.     IF (REG(%AX) = %idAX AND REG(%DX) = %idDX AND REG(%BX) = %cmdUnload) THEN
  968.         ERROR %eNotLoaded
  969.     END IF
  970.  
  971. CASE %cmdScanPort
  972.  
  973. ' should be okay
  974.  
  975.     CALL ChkHdRisk (zfirstval,zlastval)
  976.  
  977.     IF GoOnAfterWarning=%False THEN ERROR %eAborted
  978.  
  979.     method=zmethod
  980.     FOR i = zfirstval TO zlastval
  981.         CALL readport (i,vlo,vhi)
  982.         CALL showioport(i,vlo,vhi)
  983.     NEXT
  984. CASE %cmdFree
  985.  
  986.     IF GoOnAfterWarning=%False THEN ERROR %eAborted
  987.  
  988.     method=zmethod
  989.     FOR i = zfirstval TO zlastval
  990.         SELECT CASE i
  991.         CASE %firstHD TO %lastHD
  992.             CALL SkipIOport(i)
  993.         CASE %firstFD TO %lastFD
  994.             CALL SkipIOport(i)
  995.         CASE ELSE
  996.             CALL readport (i,vlo,vhi)
  997.             IF isfree(vlo,vhi)=%true THEN CALL showioport(i,vlo,vhi)
  998.         END SELECT
  999.     NEXT
  1000. CASE %cmdUsed
  1001.  
  1002.     IF GoOnAfterWarning=%False THEN ERROR %eAborted
  1003.  
  1004.     method=zmethod
  1005.     FOR i = zfirstval TO zlastval
  1006.         SELECT CASE i
  1007.         CASE %firstHD TO %lastHD
  1008.             CALL SkipIOport(i)
  1009.         CASE %firstFD TO %lastFD
  1010.             CALL SkipIOport(i)
  1011.         CASE ELSE
  1012.             CALL readport (i,vlo,vhi)
  1013.             IF isfree(vlo,vhi)=%false THEN CALL showioport(i,vlo,vhi)
  1014.         END SELECT
  1015.     NEXT
  1016. END SELECT
  1017. SELECT CASE cmd
  1018. CASE %cmdScanPort,%cmdFree,%cmdUsed
  1019.     CALL ChkReboot
  1020. END SELECT
  1021. END %eNone-%eNone
  1022.  
  1023.  
  1024.